任务一 折线图

data <- read.csv("D:/data/data.csv", header = TRUE, stringsAsFactors = FALSE)

library(zoo)
#读入后时间变量是整数类型,首先用as.character()将其转化为字符类型,再用zoo包中的as.yearmon()函数转化为yearmon类型
month <- as.yearmon(as.character(data$时间), format = "%Y%m")
#构建数据框,第一列为时间,第二列为产品销量
sale_df <- data.frame(salemonth = data$时间, sale_amount = data$某产品销量)
#按照时间排序,创建有序的时间序列对象(即zoo类型)
#数据部分为产品销量sale_amount,索引部分为时间
sale <- with(sale_df, zoo(sale_amount, order.by = month))

#画出某产品销量的时序图,不显示x轴,type = "b"表示画出点线图
plot(sale, xaxt = 'n', type = "b", xlab = "", ylab = "某产品销售量", main = "某产品销量时序图")

#构建以月度为分割的x轴
#将时间以1为步长进行划分,即得到以月分割的时间
axis_year <- month[seq(1, length(month), by = 1)]
#画出x轴,las=2表示坐标轴的标签文字为竖排
axis(1, axis_year, format(axis_year, '%Y%m'), las = 2)
#用红线标记出年份,红线的宽度为2
abline(v = c(month[12], month[24]), col = "red", lwd = 2)

#画出某产品销量的时序图,不显示x轴,type = "b"表示画出点线图
plot(sale, xaxt = 'n', type = "b", xlab = "", ylab = "某产品销售量", main = "某产品销量时序图")
#构建以季度为分割的x轴
#将时间以3为步长进行划分,即得到以季度分割的时间
axis_season <- month[seq(1, length(month), by = 3)]
#画出x轴,las=2表示坐标轴的标签文字为竖排
axis(1, axis_season, format(axis_year, '%Y%m')[seq(1, 36, by = 3)], las = 2)
#用红线标记出年份,红线的宽度为2
abline(v = c(month[12], month[24]), col = "red", lwd = 2)

任务二 折线图

data <- read.csv("D:/data/data.csv", header = TRUE, stringsAsFactors = FALSE)
#读入后时间变量是整数类型,首先用as.character()将其转化为字符类型,再用zoo包中的as.yearmon()函数转化为yearmon类型
month <- as.yearmon(as.character(data$时间), format = "%Y%m")

#构建数据框,第一列为时间,第二列为当月新增贷款,第三列为某产品销量
load_sale_df <- data.frame(time = data$时间, load = data$当月新增贷款, sale_amount = data$某产品销量)

#画出某产品销量的时序图,不显示x轴,type = "b"表示画出点线图
#对产品销量取对数
plot(x = month, y = log(data$某产品销量), type = "b", ylim = c(4, 12), xaxt = "n", xlab = "", ylab = "对数销量", main = "当月新增贷款与某产品销量对比")
#在上一张图的基础上,添加新的图形
par(new = TRUE)
#在上一张图上继续画出当月新增贷款的时序图,不显示x轴,type = "b"表示画出点线图
#由于两个变量共用一个x轴,所以这里不显示y轴
#对新增贷款取对数
plot(x = month, y = log(data$当月新增贷款), type = "b", col = "red", ylim = c(4, 12), xaxt = "n", yaxt = "n", xlab = "", main = "", ylab = "")
#添加图例
legend("topleft", c("当月新增贷款", "某产品销量"),
       col = c("red", "black"), lty = c(1, 1), cex = 0.7)

#添加x轴
#将时间以1为步长进行划分,即得到以月分割的时间
axis_year <- month[seq(1, length(month), by = 1)]
#画出x轴,las=2表示坐标轴的标签文字为竖排
axis(1, axis_year, format(axis_year, '%Y%m'), las = 2)

任务三 双坐标轴折线图

双y轴的图形可以直接使用plotrix包中的twoord.plot()函数进行绘制,

但是由于twoord.plot()函数无法去掉边框,画出的图与给出的范例略有差异,

所以这里使用两次plot()函数分别对两个变量作图,通过设置par(new=TRUE)使两个变量的图叠加,手动添加右侧y轴。

#画出当月新增贷款的时序图,不显示x轴,设置bty="n"表示不添加图形边框
plot(x = month, y = data$当月新增贷款, type = "b", bty = "n", xaxt = "n", xlab = NA, ylab = "当月新增贷款", main = "当月新增贷款与房地产投资额对比")
#在上一张图的基础上添加下一张图
par(new = TRUE)
#画出房地产开发投资额的时序图,点的类型为"*",不显示x轴和y轴
plot(x = month, y = data$房地产开发投资额, type = "b", pch="*", col = "red", axes=F, bty = "n", xlab=NA, ylab=NA)
#添加右侧的y轴,颜色为红色
axis(side = 4, col = "red", col.axis = "red")
axis(1, axis_year, format(axis_year, '%Y%m'), las = 2)
#添加图例
legend("topleft", c("当月新增贷款", "房地产投资额"),
       col = c("black", "red"), lty = c(1, 1), pch = c("o", "*"))

任务四 plotly添加发布会日期

library(plotly)
library(dplyr)
#载入数据
load("D:/data/AAPL.rda")
annouced <- c("2010-06-07", "2011-10-04", "2012-09-12", "2013-09-10", "2014-09-09", "2015-09-09", "2016-09-08")
product <- c("iPhone 4", "iPhone 4s", "iPhone 5", "iPhone 5s", "iPhone 6", "iPhone 6s", "iPhone 7")
#构建包含所有时间和对应的收盘价的数据框
mat = data.frame(Date = AAPL$Date, 
                   AAPL = round(AAPL$Adj.Close, 2))

#找到新手机发布时对应的收盘价
#由于给出的数据中时间是倒序排列,而发布时间annouced是正序排列,所以通过rev()函数将顺序反转
close_phone <- rev(round(AAPL$Adj.Close[which(AAPL$Date %in% annouced)],2))

#构建包含新产品发布的时间、手机名称和对应收盘价的数据框
#第一列为发布时间,第二列为发布的手机名称,第三列是发布时间对应的收盘价
mat2 <- data.frame(annouced, product, close_phone)

#由于需要将三条轨迹叠加,所以先画出空的图,再依次叠加三条轨迹
fig <- plot_ly()

#第一条轨迹是收盘价的时序图
#模式为"lines",表示用线将所有点连接
fig <- fig %>% 
  add_trace(data=mat, x = ~ Date, y = ~ AAPL, 
            type = 'scatter', mode = 'lines', name = '股票价格') 

#第二条轨迹是在发布手机的位置处标上手机的名称
#模式为"text",表示在点附近标出手机的名称
#showlegend=F表示在图例中不显示这条轨迹
fig <- fig %>% 
  add_trace(data=mat2, x = ~annouced, y = ~close_phone, 
            type = 'scatter', mode = 'text', text = ~product, showlegend = F)

#第三条轨迹是在发布手机的位置标出点
#模式为"markers",表示进行点的标记
fig <- fig %>% 
  add_trace(data=mat2, x = ~annouced, y = ~close_phone, 
            type = 'scatter', mode = 'markers', name = "发布会")

#设置x轴,y轴和图的标题
fig <- fig %>% layout(title = "苹果股票价格与新苹果手机的发布", xaxis = list(title = " ", showticklabels = TRUE, tickfont = list(size = 8)), yaxis = list(title = "调整收盘价(美元)"))

#图的显示
fig

任务五 文本分段

#读入文本
novel_txt <- readLines("D:/data/倚天屠龙记.txt", encoding = "UTF-8")
#所有段落开头的标值是开头有四个空格,开头用"^"表示
para_start <- grep("^    ",novel_txt,value = FALSE)
#将段落内容存入para中
para <- rep("", length(para_start))
for(i in 1:(length(para_start)-1)){
#第i段包含的行是第para_start[i]行至第((para_start[i+1])-1)行
  para_line <- seq(from = para_start[i], to = (para_start[i+1])-1, by=1)
#对每一段落的所有行进行拼接,存入para中
  para[i] <- paste(novel_txt[para_line], sep = "", collapse = "")
}
#用表格形式显示前4个段落
knitr::kable(head(para, 4), format = "html", row.names = TRUE, col.names = "《倚天屠龙记》前四段")
《倚天屠龙记》前四段
1 一  天涯思君不可忘
2 “春游浩荡,是年年寒食,梨花时节。白锦无纹香烂漫,玉树琼苞堆雪。静夜沉沉,浮光霭霭,冷浸溶溶月。人间天上,烂银霞照通彻。浑似姑射真人,天姿灵秀,意气殊高洁。万蕊参差谁信道,不与群芳同列。浩气清英,仙才卓荦,下土难分别。瑶台归去,洞天方看清绝。”
3 作这一首《无俗念》词的,乃南宋末年一位武学名家,有道之士。此人姓丘,名处机,道号长春子,名列全真七子之一,是全真教中出类拔萃的人物。《词品》评论此词道:“长春,世之所谓仙人也,而词之清拔如此”。这首词诵的似是梨花,其实词中真意却是赞誉一位身穿白衣的美貌少女,说她“浑似姑射真人,天姿灵秀,意气殊高洁”,又说她“浩气清英,仙才卓荦”,“不与群芳同列”。词中所颂这美女,乃古墓派传人小龙女。她一生爱穿白衣,当真如风拂玉树,雪裹琼苞,兼之生性清冷,实当得起“冷浸溶溶月”的形容,以“无俗念”三字赠之,可说十分贴切。长春子丘处机和她在终南山上比邻而居,当年一见,便写下这首词来。
4 这时丘处机逝世已久,小龙女也已嫁与神雕大侠杨过为妻。在河南少室山山道之上,却另有一个少女,正在低低念诵此词。这少女十八九岁年纪,身穿淡黄衣衫,骑着一头青驴,正沿山道缓缓而上,心中默想:“也只有龙姊姊这样的人物,才配得上他。”这一个“他”字,指的自然是神雕大侠杨过了。她也不拉缰绳,任由那青驴信步而行,一路上山。过了良久,她又低声吟道:“欢乐趣,离别苦,就中更有痴儿女。君应有语,渺万里层云,千山暮雪,只影向谁去?”